home *** CD-ROM | disk | FTP | other *** search
/ Ultra Pack / UltraComputing Partner Applications.iso / SunLabs / tclTK / src / tcl7.4 / tclUnixUtil.c < prev    next >
Encoding:
C/C++ Source or Header  |  1995-03-29  |  38.1 KB  |  1,443 lines
  1. /* 
  2.  * tclUnixUtil.c --
  3.  *
  4.  *    This file contains a collection of utility procedures that
  5.  *    are present in the Tcl's UNIX core but not in the generic
  6.  *    core.  For example, they do file manipulation and process
  7.  *    manipulation.
  8.  *
  9.  *    Parts of this file are based on code contributed by Karl
  10.  *    Lehenbauer, Mark Diekhans and Peter da Silva.
  11.  *
  12.  * Copyright (c) 1991-1994 The Regents of the University of California.
  13.  * Copyright (c) 1994 Sun Microsystems, Inc.
  14.  *
  15.  * See the file "license.terms" for information on usage and redistribution
  16.  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  17.  */
  18.  
  19. #ifndef lint
  20. static char sccsid[] = "@(#) tclUnixUtil.c 1.55 95/03/29 11:24:23";
  21. #endif /* not lint */
  22.  
  23. #include "tclInt.h"
  24. #include "tclPort.h"
  25.  
  26. /*
  27.  * A linked list of the following structures is used to keep track
  28.  * of child processes that have been detached but haven't exited
  29.  * yet, so we can make sure that they're properly "reaped" (officially
  30.  * waited for) and don't lie around as zombies cluttering the
  31.  * system.
  32.  */
  33.  
  34. typedef struct Detached {
  35.     int pid;                /* Id of process that's been detached
  36.                      * but isn't known to have exited. */
  37.     struct Detached *nextPtr;        /* Next in list of all detached
  38.                      * processes. */
  39. } Detached;
  40.  
  41. static Detached *detList = NULL;    /* List of all detached proceses. */
  42.  
  43. /*
  44.  * The following variables are used to keep track of all the open files
  45.  * in the process.  These files can be shared across interpreters, so the
  46.  * information can't be put in the Interp structure.
  47.  */
  48.  
  49. int tclNumFiles = 0;        /* Number of entries in tclOpenFiles below.
  50.                  * 0 means array hasn't been created yet. */
  51. OpenFile **tclOpenFiles;    /* Pointer to malloc-ed array of pointers
  52.                  * to information about open files.  Entry
  53.                  * N corresponds to the file with fileno N.
  54.                  * If an entry is NULL then the corresponding
  55.                  * file isn't open.  If tclOpenFiles is NULL
  56.                  * it means no files have been used, so even
  57.                  * stdin/stdout/stderr entries haven't been
  58.                  * setup yet. */
  59.  
  60. /*
  61.  * Declarations for local procedures defined in this file:
  62.  */
  63.  
  64. static int        FileForRedirect _ANSI_ARGS_((Tcl_Interp *interp,
  65.                 char *spec, int atOk, char *arg, int flags,
  66.                 char *nextArg, int *skipPtr, int *closePtr));
  67. static void        MakeFileTable _ANSI_ARGS_((Interp *iPtr, int index));
  68. static void        RestoreSignals _ANSI_ARGS_((void));
  69.  
  70. /*
  71.  *----------------------------------------------------------------------
  72.  *
  73.  * Tcl_EvalFile --
  74.  *
  75.  *    Read in a file and process the entire file as one gigantic
  76.  *    Tcl command.
  77.  *
  78.  * Results:
  79.  *    A standard Tcl result, which is either the result of executing
  80.  *    the file or an error indicating why the file couldn't be read.
  81.  *
  82.  * Side effects:
  83.  *    Depends on the commands in the file.
  84.  *
  85.  *----------------------------------------------------------------------
  86.  */
  87.  
  88. int
  89. Tcl_EvalFile(interp, fileName)
  90.     Tcl_Interp *interp;        /* Interpreter in which to process file. */
  91.     char *fileName;        /* Name of file to process.  Tilde-substitution
  92.                  * will be performed on this name. */
  93. {
  94.     int fileId, result;
  95.     struct stat statBuf;
  96.     char *cmdBuffer, *oldScriptFile;
  97.     Interp *iPtr = (Interp *) interp;
  98.     Tcl_DString buffer;
  99.  
  100.     Tcl_ResetResult(interp);
  101.     oldScriptFile = iPtr->scriptFile;
  102.     iPtr->scriptFile = fileName;
  103.     fileName = Tcl_TildeSubst(interp, fileName, &buffer);
  104.     if (fileName == NULL) {
  105.     goto error;
  106.     }
  107.     fileId = open(fileName, O_RDONLY, 0);
  108.     if (fileId < 0) {
  109.     Tcl_AppendResult(interp, "couldn't read file \"", fileName,
  110.         "\": ", Tcl_PosixError(interp), (char *) NULL);
  111.     goto error;
  112.     }
  113.     if (fstat(fileId, &statBuf) == -1) {
  114.     Tcl_AppendResult(interp, "couldn't stat file \"", fileName,
  115.         "\": ", Tcl_PosixError(interp), (char *) NULL);
  116.     close(fileId);
  117.     goto error;
  118.     }
  119.     cmdBuffer = (char *) ckalloc((unsigned) statBuf.st_size+1);
  120.     if (read(fileId, cmdBuffer, (size_t) statBuf.st_size) != statBuf.st_size) {
  121.     Tcl_AppendResult(interp, "error in reading file \"", fileName,
  122.         "\": ", Tcl_PosixError(interp), (char *) NULL);
  123.     close(fileId);
  124.     ckfree(cmdBuffer);
  125.     goto error;
  126.     }
  127.     if (close(fileId) != 0) {
  128.     Tcl_AppendResult(interp, "error closing file \"", fileName,
  129.         "\": ", Tcl_PosixError(interp), (char *) NULL);
  130.     ckfree(cmdBuffer);
  131.     goto error;
  132.     }
  133.     cmdBuffer[statBuf.st_size] = 0;
  134.     result = Tcl_Eval(interp, cmdBuffer);
  135.     if (result == TCL_RETURN) {
  136.     result = TclUpdateReturnInfo(iPtr);
  137.     } else if (result == TCL_ERROR) {
  138.     char msg[200];
  139.  
  140.     /*
  141.      * Record information telling where the error occurred.
  142.      */
  143.  
  144.     sprintf(msg, "\n    (file \"%.150s\" line %d)", fileName,
  145.         interp->errorLine);
  146.     Tcl_AddErrorInfo(interp, msg);
  147.     }
  148.     ckfree(cmdBuffer);
  149.     iPtr->scriptFile = oldScriptFile;
  150.     Tcl_DStringFree(&buffer);
  151.     return result;
  152.  
  153.     error:
  154.     iPtr->scriptFile = oldScriptFile;
  155.     Tcl_DStringFree(&buffer);
  156.     return TCL_ERROR;
  157. }
  158.  
  159. /*
  160.  *----------------------------------------------------------------------
  161.  *
  162.  * Tcl_DetachPids --
  163.  *
  164.  *    This procedure is called to indicate that one or more child
  165.  *    processes have been placed in background and will never be
  166.  *    waited for;  they should eventually be reaped by
  167.  *    Tcl_ReapDetachedProcs.
  168.  *
  169.  * Results:
  170.  *    None.
  171.  *
  172.  * Side effects:
  173.  *    None.
  174.  *
  175.  *----------------------------------------------------------------------
  176.  */
  177.  
  178. void
  179. Tcl_DetachPids(numPids, pidPtr)
  180.     int numPids;        /* Number of pids to detach:  gives size
  181.                  * of array pointed to by pidPtr. */
  182.     int *pidPtr;        /* Array of pids to detach. */
  183. {
  184.     register Detached *detPtr;
  185.     int i;
  186.  
  187.     for (i = 0; i < numPids; i++) {
  188.     detPtr = (Detached *) ckalloc(sizeof(Detached));
  189.     detPtr->pid = pidPtr[i];
  190.     detPtr->nextPtr = detList;
  191.     detList = detPtr;
  192.     }
  193. }
  194.  
  195. /*
  196.  *----------------------------------------------------------------------
  197.  *
  198.  * Tcl_ReapDetachedProcs --
  199.  *
  200.  *    This procedure checks to see if any detached processes have
  201.  *    exited and, if so, it "reaps" them by officially waiting on
  202.  *    them.  It should be called "occasionally" to make sure that
  203.  *    all detached processes are eventually reaped.
  204.  *
  205.  * Results:
  206.  *    None.
  207.  *
  208.  * Side effects:
  209.  *    Processes are waited on, so that they can be reaped by the
  210.  *    system.
  211.  *
  212.  *----------------------------------------------------------------------
  213.  */
  214.  
  215. void
  216. Tcl_ReapDetachedProcs()
  217. {
  218.     register Detached *detPtr;
  219.     Detached *nextPtr, *prevPtr;
  220.     int status, result;
  221.  
  222.     for (detPtr = detList, prevPtr = NULL; detPtr != NULL; ) {
  223.     result = waitpid(detPtr->pid, &status, WNOHANG);
  224.     if ((result == 0) || ((result == -1) && (errno != ECHILD))) {
  225.         prevPtr = detPtr;
  226.         detPtr = detPtr->nextPtr;
  227.         continue;
  228.     }
  229.     nextPtr = detPtr->nextPtr;
  230.     if (prevPtr == NULL) {
  231.         detList = detPtr->nextPtr;
  232.     } else {
  233.         prevPtr->nextPtr = detPtr->nextPtr;
  234.     }
  235.     ckfree((char *) detPtr);
  236.     detPtr = nextPtr;
  237.     }
  238. }
  239.  
  240. /*
  241.  *----------------------------------------------------------------------
  242.  *
  243.  * Tcl_CreatePipeline --
  244.  *
  245.  *    Given an argc/argv array, instantiate a pipeline of processes
  246.  *    as described by the argv.
  247.  *
  248.  * Results:
  249.  *    The return value is a count of the number of new processes
  250.  *    created, or -1 if an error occurred while creating the pipeline.
  251.  *    *pidArrayPtr is filled in with the address of a dynamically
  252.  *    allocated array giving the ids of all of the processes.  It
  253.  *    is up to the caller to free this array when it isn't needed
  254.  *    anymore.  If inPipePtr is non-NULL, *inPipePtr is filled in
  255.  *    with the file id for the input pipe for the pipeline (if any):
  256.  *    the caller must eventually close this file.  If outPipePtr
  257.  *    isn't NULL, then *outPipePtr is filled in with the file id
  258.  *    for the output pipe from the pipeline:  the caller must close
  259.  *    this file.  If errFilePtr isn't NULL, then *errFilePtr is filled
  260.  *    with a file id that may be used to read error output after the
  261.  *    pipeline completes.
  262.  *
  263.  * Side effects:
  264.  *    Processes and pipes are created.
  265.  *
  266.  *----------------------------------------------------------------------
  267.  */
  268.  
  269. int
  270. Tcl_CreatePipeline(interp, argc, argv, pidArrayPtr, inPipePtr,
  271.     outPipePtr, errFilePtr)
  272.     Tcl_Interp *interp;        /* Interpreter to use for error reporting. */
  273.     int argc;            /* Number of entries in argv. */
  274.     char **argv;        /* Array of strings describing commands in
  275.                  * pipeline plus I/O redirection with <,
  276.                  * <<,  >, etc.  Argv[argc] must be NULL. */
  277.     int **pidArrayPtr;        /* Word at *pidArrayPtr gets filled in with
  278.                  * address of array of pids for processes
  279.                  * in pipeline (first pid is first process
  280.                  * in pipeline). */
  281.     int *inPipePtr;        /* If non-NULL, input to the pipeline comes
  282.                  * from a pipe (unless overridden by
  283.                  * redirection in the command).  The file
  284.                  * id with which to write to this pipe is
  285.                  * stored at *inPipePtr.  -1 means command
  286.                  * specified its own input source. */
  287.     int *outPipePtr;        /* If non-NULL, output to the pipeline goes
  288.                  * to a pipe, unless overriden by redirection
  289.                  * in the command.  The file id with which to
  290.                  * read frome this pipe is stored at
  291.                  * *outPipePtr.  -1 means command specified
  292.                  * its own output sink. */
  293.     int *errFilePtr;        /* If non-NULL, all stderr output from the
  294.                  * pipeline will go to a temporary file
  295.                  * created here, and a descriptor to read
  296.                  * the file will be left at *errFilePtr.
  297.                  * The file will be removed already, so
  298.                  * closing this descriptor will be the end
  299.                  * of the file.  If this is NULL, then
  300.                  * all stderr output goes to our stderr.
  301.                  * If the pipeline specifies redirection
  302.                  * then the fill will still be created
  303.                  * but it will never get any data. */
  304. {
  305.     int *pidPtr = NULL;        /* Points to malloc-ed array holding all
  306.                  * the pids of child processes. */
  307.     int numPids = 0;        /* Actual number of processes that exist
  308.                  * at *pidPtr right now. */
  309.     int cmdCount;        /* Count of number of distinct commands
  310.                  * found in argc/argv. */
  311.     char *input = NULL;        /* If non-null, then this points to a
  312.                  * string containing input data (specified
  313.                  * via <<) to be piped to the first process
  314.                  * in the pipeline. */
  315.     int inputId = -1;        /* If >= 0, gives file id to use as input for
  316.                  * first process in pipeline (specified via
  317.                  * < or <@). */
  318.     int closeInput = 0;        /* If non-zero, then must close inputId
  319.                  * when cleaning up (zero means the file needs
  320.                  * to stay open for some other reason). */
  321.     int outputId = -1;        /* Writable file id for output from last
  322.                  * command in pipeline (could be file or pipe).
  323.                  * -1 means use stdout. */
  324.     int closeOutput = 0;    /* Non-zero means must close outputId when
  325.                  * cleaning up (similar to closeInput). */
  326.     int errorId = -1;        /* Writable file id for error output from
  327.                  * all commands in pipeline. -1 means use
  328.                  * stderr. */
  329.     int closeError = 0;        /* Non-zero means must close errorId when
  330.                  * cleaning up. */
  331.     int pipeIds[2];        /* File ids for pipe that's being created. */
  332.     int firstArg, lastArg;    /* Indexes of first and last arguments in
  333.                  * current command. */
  334.     int skip;            /* Number of arguments to skip (because they
  335.                  * specify redirection). */
  336.     int maxFd;            /* Highest known file descriptor (used to
  337.                  * close off extraneous file descriptors in
  338.                  * child process). */
  339.     int errPipeIds[2];        /* Used for communication between parent and
  340.                  * child processes.  If child encounters
  341.                  * error during startup it returns error
  342.                  * message via pipe.  If child starts up
  343.                  * OK, it closes pipe without anything in
  344.                  * it. */
  345.     int lastBar;
  346.     char *execName;
  347.     int i, j, pid, count;
  348.     char *p;
  349.     Tcl_DString buffer;
  350.     char errSpace[200];
  351.  
  352.     if (inPipePtr != NULL) {
  353.     *inPipePtr = -1;
  354.     }
  355.     if (outPipePtr != NULL) {
  356.     *outPipePtr = -1;
  357.     }
  358.     if (errFilePtr != NULL) {
  359.     *errFilePtr = -1;
  360.     }
  361.     pipeIds[0] = pipeIds[1] = -1;
  362.     errPipeIds[0] = errPipeIds[1] = -1;
  363.  
  364.     /*
  365.      * First, scan through all the arguments to figure out the structure
  366.      * of the pipeline.  Process all of the input and output redirection
  367.      * arguments and remove them from the argument list in the pipeline.
  368.      * Count the number of distinct processes (it's the number of "|"
  369.      * arguments plus one) but don't remove the "|" arguments.
  370.      */
  371.  
  372.     cmdCount = 1;
  373.     lastBar = -1;
  374.     for (i = 0; i < argc; i++) {
  375.     if ((argv[i][0] == '|') && (((argv[i][1] == 0))
  376.         || ((argv[i][1] == '&') && (argv[i][2] == 0)))) {
  377.         if ((i == (lastBar+1)) || (i == (argc-1))) {
  378.         interp->result = "illegal use of | or |& in command";
  379.         return -1;
  380.         }
  381.         lastBar = i;
  382.         cmdCount++;
  383.         continue;
  384.     } else if (argv[i][0] == '<') {
  385.         if ((inputId >= 0) && closeInput) {
  386.         close(inputId);
  387.         }
  388.         inputId = -1;
  389.         skip = 1;
  390.         if (argv[i][1] == '<') {
  391.         input = argv[i]+2;
  392.         if (*input == 0) {
  393.             input = argv[i+1];
  394.             if (input == 0) {
  395.             Tcl_AppendResult(interp, "can't specify \"", argv[i],
  396.                 "\" as last word in command", (char *) NULL);
  397.             goto error;
  398.             }
  399.             skip = 2;
  400.         }
  401.         } else {
  402.         input = 0;
  403.         inputId = FileForRedirect(interp, argv[i]+1, 1, argv[i],
  404.             O_RDONLY, argv[i+1], &skip, &closeInput);
  405.         if (inputId < 0) {
  406.             goto error;
  407.         }
  408.         }
  409.     } else if (argv[i][0] == '>') {
  410.         int append, useForStdErr, useForStdOut, mustClose, fd, atOk, flags;
  411.  
  412.         skip = atOk = 1;
  413.         append = useForStdErr = 0;
  414.         useForStdOut = 1;
  415.         if (argv[i][1] == '>') {
  416.         p = argv[i] + 2;
  417.         append = 1;
  418.         atOk = 0;
  419.         flags = O_WRONLY|O_CREAT;
  420.         } else {
  421.         p = argv[i] + 1;
  422.         flags = O_WRONLY|O_CREAT|O_TRUNC;
  423.         }
  424.         if (*p == '&') {
  425.         useForStdErr = 1;
  426.         p++;
  427.         }
  428.         fd = FileForRedirect(interp, p, atOk, argv[i], flags, argv[i+1],
  429.             &skip, &mustClose);
  430.         if (fd < 0) {
  431.         goto error;
  432.         }
  433.         if (append) {
  434.         lseek(fd, 0L, 2);
  435.         }
  436.  
  437.         /*
  438.          * Got the file descriptor.  Now use it for standard output,
  439.          * standard error, or both, depending on the redirection.
  440.          */
  441.  
  442.         if (useForStdOut) {
  443.         if ((outputId > 0) && closeOutput) {
  444.             close(outputId);
  445.         }
  446.         outputId = fd;
  447.         closeOutput = mustClose;
  448.         }
  449.         if (useForStdErr) {
  450.         if ((errorId > 0) && closeError) {
  451.             close(errorId);
  452.         }
  453.         errorId = fd;
  454.         closeError = (useForStdOut) ? 0 : mustClose;
  455.         }
  456.     } else if ((argv[i][0] == '2') && (argv[i][1] == '>')) {
  457.         int append, atOk, flags;
  458.  
  459.         if ((errorId > 0) && closeError) {
  460.         close(errorId);
  461.         }
  462.         skip = 1;
  463.         p = argv[i] + 2;
  464.         if (*p == '>') {
  465.         p++;
  466.         append = 1;
  467.         atOk = 0;
  468.         flags = O_WRONLY|O_CREAT;
  469.         } else {
  470.         append = 0;
  471.         atOk = 1;
  472.         flags = O_WRONLY|O_CREAT|O_TRUNC;
  473.         }
  474.         errorId = FileForRedirect(interp, p, atOk, argv[i], flags,
  475.             argv[i+1], &skip, &closeError);
  476.         if (errorId < 0) {
  477.         goto error;
  478.         }
  479.         if (append) {
  480.         lseek(errorId, 0L, 2);
  481.         }
  482.     } else {
  483.         continue;
  484.     }
  485.     for (j = i+skip; j < argc; j++) {
  486.         argv[j-skip] = argv[j];
  487.     }
  488.     argc -= skip;
  489.     i -= 1;            /* Process next arg from same position. */
  490.     }
  491.     if (argc == 0) {
  492.     interp->result =  "didn't specify command to execute";
  493.     return -1;
  494.     }
  495.  
  496.     if (inputId < 0) {
  497.     if (input != NULL) {
  498.         char inName[L_tmpnam];
  499.         int length;
  500.  
  501.         /*
  502.          * The input for the first process is immediate data coming from
  503.          * Tcl.  Create a temporary file for it and put the data into the
  504.          * file.
  505.          */
  506.  
  507.         tmpnam(inName);
  508.         inputId = open(inName, O_RDWR|O_CREAT|O_TRUNC, 0600);
  509.         closeInput = 1;
  510.         if (inputId < 0) {
  511.         Tcl_AppendResult(interp,
  512.             "couldn't create input file \"", inName,
  513.             "\" for command: ", Tcl_PosixError(interp),
  514.             (char *) NULL);
  515.         goto error;
  516.         }
  517.         length = strlen(input);
  518.         if (write(inputId, input, (size_t) length) != length) {
  519.         Tcl_AppendResult(interp,
  520.             "couldn't write file input for command: ",
  521.             Tcl_PosixError(interp), (char *) NULL);
  522.         goto error;
  523.         }
  524.         if ((lseek(inputId, 0L, 0) == -1) || (unlink(inName) == -1)) {
  525.         Tcl_AppendResult(interp,
  526.             "couldn't reset or remove input file for command: ",
  527.             Tcl_PosixError(interp), (char *) NULL);
  528.         goto error;
  529.         }
  530.     } else if (inPipePtr != NULL) {
  531.         /*
  532.          * The input for the first process in the pipeline is to
  533.          * come from a pipe that can be written from this end.
  534.          */
  535.  
  536.         if (pipe(pipeIds) != 0) {
  537.         Tcl_AppendResult(interp,
  538.             "couldn't create input pipe for command: ",
  539.             Tcl_PosixError(interp), (char *) NULL);
  540.         goto error;
  541.         }
  542.         inputId = pipeIds[0];
  543.         closeInput = 1;
  544.         *inPipePtr = pipeIds[1];
  545.         pipeIds[0] = pipeIds[1] = -1;
  546.     }
  547.     }
  548.  
  549.     /*
  550.      * Set up a pipe to receive output from the pipeline, if no other
  551.      * output sink has been specified.
  552.      */
  553.  
  554.     if ((outputId < 0) && (outPipePtr != NULL)) {
  555.     if (pipe(pipeIds) != 0) {
  556.         Tcl_AppendResult(interp,
  557.             "couldn't create output pipe: ",
  558.             Tcl_PosixError(interp), (char *) NULL);
  559.         goto error;
  560.     }
  561.     outputId = pipeIds[1];
  562.     closeOutput = 1;
  563.     *outPipePtr = pipeIds[0];
  564.     pipeIds[0] = pipeIds[1] = -1;
  565.     }
  566.  
  567.     /*
  568.      * Set up the standard error output sink for the pipeline, if
  569.      * requested.  Use a temporary file which is opened, then deleted.
  570.      * Could potentially just use pipe, but if it filled up it could
  571.      * cause the pipeline to deadlock:  we'd be waiting for processes
  572.      * to complete before reading stderr, and processes couldn't complete
  573.      * because stderr was backed up.
  574.      */
  575.  
  576.     if (errFilePtr != NULL) {
  577.     char errName[L_tmpnam];
  578.  
  579.     tmpnam(errName);
  580.     *errFilePtr = open(errName, O_RDONLY|O_CREAT|O_TRUNC, 0600);
  581.     if (*errFilePtr < 0) {
  582.         errFileError:
  583.         Tcl_AppendResult(interp,
  584.             "couldn't create error file \"", errName,
  585.             "\" for command: ", Tcl_PosixError(interp),
  586.             (char *) NULL);
  587.         goto error;
  588.     }
  589.     if (errorId < 0) {
  590.         errorId = open(errName, O_WRONLY|O_CREAT|O_TRUNC, 0600);
  591.         if (errorId < 0) {
  592.         goto errFileError;
  593.         }
  594.         closeError = 1;
  595.     }
  596.     if (unlink(errName) == -1) {
  597.         Tcl_AppendResult(interp,
  598.             "couldn't remove error file for command: ",
  599.             Tcl_PosixError(interp), (char *) NULL);
  600.         goto error;
  601.     }
  602.     }
  603.  
  604.     /*
  605.      * Find the largest file descriptor used so far, so that we can
  606.      * clean up all the extraneous file descriptors in the child
  607.      * processes we create.
  608.      */
  609.  
  610.     maxFd = inputId;
  611.     if (outputId > maxFd) {
  612.     maxFd = outputId;
  613.     }
  614.     if (errorId > maxFd) {
  615.     maxFd = errorId;
  616.     }
  617.     if ((inPipePtr != NULL) && (*inPipePtr > maxFd)) {
  618.     maxFd = *inPipePtr;
  619.     }
  620.     if ((outPipePtr != NULL) && (*outPipePtr > maxFd)) {
  621.     maxFd = *outPipePtr;
  622.     }
  623.     if ((errFilePtr != NULL) && (*errFilePtr > maxFd)) {
  624.     maxFd = *errFilePtr;
  625.     }
  626.  
  627.     /*
  628.      * Scan through the argc array, forking off a process for each
  629.      * group of arguments between "|" arguments.
  630.      */
  631.  
  632.     pidPtr = (int *) ckalloc((unsigned) (cmdCount * sizeof(int)));
  633.     for (i = 0; i < numPids; i++) {
  634.     pidPtr[i] = -1;
  635.     }
  636.     Tcl_ReapDetachedProcs();
  637.     for (firstArg = 0; firstArg < argc; numPids++, firstArg = lastArg+1) {
  638.     int joinThisError;
  639.     int curOutputId;
  640.  
  641.     joinThisError = 0;
  642.     for (lastArg = firstArg; lastArg < argc; lastArg++) {
  643.         if (argv[lastArg][0] == '|') {
  644.         if (argv[lastArg][1] == 0) {
  645.             break;
  646.         }
  647.         if ((argv[lastArg][1] == '&') && (argv[lastArg][2] == 0)) {
  648.             joinThisError = 1;
  649.             break;
  650.         }
  651.         }
  652.     }
  653.     argv[lastArg] = NULL;
  654.     if (lastArg == argc) {
  655.         curOutputId = outputId;
  656.     } else {
  657.         if (pipe(pipeIds) != 0) {
  658.         Tcl_AppendResult(interp, "couldn't create pipe: ",
  659.             Tcl_PosixError(interp), (char *) NULL);
  660.         goto error;
  661.         }
  662.         curOutputId = pipeIds[1];
  663.         if (pipeIds[0] > maxFd) {
  664.         maxFd = pipeIds[0];
  665.         }
  666.         if (pipeIds[1] > maxFd) {
  667.         maxFd = pipeIds[1];
  668.         }
  669.     }
  670.  
  671.     /*
  672.      * Create a pipe that the child can use to return error
  673.      * information if anything goes wrong.  Set the close-on-exec
  674.      * flag for the write end of the pipe so that it will be
  675.      * closed automatically if the child succesfully execs the
  676.      * new subprocess.
  677.      */
  678.  
  679.     if (pipe(errPipeIds) != 0) {
  680.         Tcl_AppendResult(interp, "couldn't create pipe: ",
  681.             Tcl_PosixError(interp), (char *) NULL);
  682.         goto error;
  683.     }
  684.     if (errPipeIds[0] > maxFd) {
  685.         maxFd = errPipeIds[0];
  686.     }
  687.     if (errPipeIds[1] > maxFd) {
  688.         maxFd = errPipeIds[1];
  689.     }
  690.     if (fcntl(errPipeIds[1], F_SETFD, FD_CLOEXEC) != 0) {
  691.         Tcl_AppendResult(interp, "couldn't set close on exec for pipe: ",
  692.             Tcl_PosixError(interp), (char *) NULL);
  693.         goto error;
  694.     }
  695.     execName = Tcl_TildeSubst(interp, argv[firstArg], &buffer);
  696.     pid = vfork();
  697.     if (pid == 0) {
  698.         if (((inputId != -1) && (dup2(inputId, 0) == -1))
  699.             || ((curOutputId != -1) && (dup2(curOutputId, 1) == -1))
  700.             || (joinThisError && (dup2(1, 2) == -1))
  701.             || (!joinThisError && (errorId != -1)
  702.                 && (dup2(errorId, 2) == -1))) {
  703.         sprintf(errSpace,
  704.             "%dforked process couldn't set up input/output: ",
  705.             errno);
  706.         write(errPipeIds[1], errSpace, (size_t) strlen(errSpace));
  707.         _exit(1);
  708.         }
  709.         for (i = 3; i <= maxFd; i++) {
  710.         if (i != errPipeIds[1]) {
  711.             close(i);
  712.         }
  713.         }
  714.         RestoreSignals();
  715.         execvp(execName, &argv[firstArg]);
  716.         sprintf(errSpace, "%dcouldn't execute \"%.150s\": ", errno,
  717.             argv[firstArg]);
  718.         write(errPipeIds[1], errSpace, (size_t) strlen(errSpace));
  719.         _exit(1);
  720.     }
  721.     Tcl_DStringFree(&buffer);
  722.     if (pid == -1) {
  723.         Tcl_AppendResult(interp, "couldn't fork child process: ",
  724.             Tcl_PosixError(interp), (char *) NULL);
  725.         goto error;
  726.     }
  727.  
  728.     /*
  729.      * Read back from the error pipe to see if the child startup
  730.      * up OK.  The info in the pipe (if any) consists of a decimal
  731.      * errno value followed by an error message.
  732.      */
  733.  
  734.     close(errPipeIds[1]);
  735.     errPipeIds[1] = -1;
  736.     count = read(errPipeIds[0], errSpace, (size_t) (sizeof(errSpace) - 1));
  737.     if (count > 0) {
  738.         char *end;
  739.         errSpace[count] = 0;
  740.         errno = strtol(errSpace, &end, 10);
  741.         Tcl_AppendResult(interp, end, Tcl_PosixError(interp),
  742.             (char *) NULL);
  743.         goto error;
  744.     }
  745.     close(errPipeIds[0]);
  746.     errPipeIds[0] = -1;
  747.     pidPtr[numPids] = pid;
  748.  
  749.     /*
  750.      * Close off our copies of file descriptors that were set up for
  751.      * this child, then set up the input for the next child.
  752.      */
  753.  
  754.     if ((inputId != -1) && closeInput) {
  755.         close(inputId);
  756.     }
  757.     if ((curOutputId != -1) && (curOutputId != outputId)) {
  758.         close(curOutputId);
  759.     }
  760.     inputId = pipeIds[0];
  761.     closeInput = 1;
  762.     pipeIds[0] = pipeIds[1] = -1;
  763.     }
  764.     *pidArrayPtr = pidPtr;
  765.  
  766.     /*
  767.      * All done.  Cleanup open files lying around and then return.
  768.      */
  769.  
  770. cleanup:
  771.     if ((inputId != -1) && closeInput) {
  772.     close(inputId);
  773.     }
  774.     if ((outputId != -1) && closeOutput) {
  775.     close(outputId);
  776.     }
  777.     if ((errorId != -1) && closeError) {
  778.     close(errorId);
  779.     }
  780.     return numPids;
  781.  
  782.     /*
  783.      * An error occurred.  There could have been extra files open, such
  784.      * as pipes between children.  Clean them all up.  Detach any child
  785.      * processes that have been created.
  786.      */
  787.  
  788.     error:
  789.     if ((inPipePtr != NULL) && (*inPipePtr != -1)) {
  790.     close(*inPipePtr);
  791.     *inPipePtr = -1;
  792.     }
  793.     if ((outPipePtr != NULL) && (*outPipePtr != -1)) {
  794.     close(*outPipePtr);
  795.     *outPipePtr = -1;
  796.     }
  797.     if ((errFilePtr != NULL) && (*errFilePtr != -1)) {
  798.     close(*errFilePtr);
  799.     *errFilePtr = -1;
  800.     }
  801.     if (pipeIds[0] != -1) {
  802.     close(pipeIds[0]);
  803.     }
  804.     if (pipeIds[1] != -1) {
  805.     close(pipeIds[1]);
  806.     }
  807.     if (errPipeIds[0] != -1) {
  808.     close(errPipeIds[0]);
  809.     }
  810.     if (errPipeIds[1] != -1) {
  811.     close(errPipeIds[1]);
  812.     }
  813.     if (pidPtr != NULL) {
  814.     for (i = 0; i < numPids; i++) {
  815.         if (pidPtr[i] != -1) {
  816.         Tcl_DetachPids(1, &pidPtr[i]);
  817.         }
  818.     }
  819.     ckfree((char *) pidPtr);
  820.     }
  821.     numPids = -1;
  822.     goto cleanup;
  823. }
  824.  
  825. /*
  826.  *----------------------------------------------------------------------
  827.  *
  828.  * FileForRedirect --
  829.  *
  830.  *    This procedure does much of the work of parsing redirection
  831.  *    operators.  It handles "@" if specified and allowed, and a file
  832.  *    name, and opens the file if necessary.
  833.  *
  834.  * Results:
  835.  *    The return value is the descriptor number for the file.  If an
  836.  *    error occurs then -1 is returned and an error message is left
  837.  *    in interp->result.  Several arguments are side-effected; see
  838.  *    the argument list below for details.
  839.  *
  840.  * Side effects:
  841.  *    None.
  842.  *
  843.  *----------------------------------------------------------------------
  844.  */
  845.  
  846. static int
  847. FileForRedirect(interp, spec, atOk, arg, flags, nextArg, skipPtr, closePtr)
  848.     Tcl_Interp *interp;            /* Intepreter to use for error
  849.                      * reporting. */
  850.     register char *spec;            /* Points to character just after
  851.                      * redirection character. */
  852.     int atOk;                /* Non-zero means '@' notation is
  853.                      * OK, zero means it isn't. */
  854.     char *arg;                /* Pointer to entire argument
  855.                      * containing spec:  used for error
  856.                      * reporting. */
  857.     int flags;                /* Flags to use for opening file. */
  858.     char *nextArg;            /* Next argument in argc/argv
  859.                      * array, if needed for file name.
  860.                      * May be NULL. */
  861.     int *skipPtr;            /* This value is incremented if
  862.                      * nextArg is used for redirection
  863.                      * spec. */
  864.     int *closePtr;            /* This value is set to 1 if the file
  865.                      * that's returned must be closed, 0
  866.                      * if it was specified with "@" so
  867.                      * it must be left open. */
  868. {
  869.     int writing = (flags & O_WRONLY);
  870.     FILE *f;
  871.     int fd;
  872.  
  873.     if (atOk && (*spec == '@')) {
  874.     spec++;
  875.     if (*spec == 0) {
  876.         spec = nextArg;
  877.         if (spec == NULL) {
  878.         goto badLastArg;
  879.         }
  880.         *skipPtr += 1;
  881.     }
  882.     if (Tcl_GetOpenFile(interp, spec, writing, 1, &f) != TCL_OK) {
  883.         return -1;
  884.     }
  885.     *closePtr = 0;
  886.     fd = fileno(f);
  887.     if (writing) {
  888.         /*
  889.          * Be sure to flush output to the file, so that anything
  890.          * written by the child appears after stuff we've already
  891.          * written.
  892.          */
  893.  
  894.         fflush(f);
  895.     }
  896.     } else {
  897.     if (*spec == 0) {
  898.         spec = nextArg;
  899.         if (spec == NULL) {
  900.         goto badLastArg;
  901.         }
  902.         *skipPtr += 1;
  903.     }
  904.     fd = open(spec, flags, 0666);
  905.     if (fd < 0) {
  906.         Tcl_AppendResult(interp, "couldn't ",
  907.             (writing) ? "write" : "read", " file \"", spec, "\": ",
  908.             Tcl_PosixError(interp), (char *) NULL);
  909.         return -1;
  910.     }
  911.     *closePtr = 1;
  912.     }
  913.     return fd;
  914.  
  915.     badLastArg:
  916.     Tcl_AppendResult(interp, "can't specify \"", arg,
  917.         "\" as last word in command", (char *) NULL);
  918.     return -1;
  919. }
  920.  
  921. /*
  922.  *----------------------------------------------------------------------
  923.  *
  924.  * RestoreSignals --
  925.  *
  926.  *    This procedure is invoked in a forked child process just before
  927.  *    exec-ing a new program to restore all signals to their default
  928.  *    settings.
  929.  *
  930.  * Results:
  931.  *    None.
  932.  *
  933.  * Side effects:
  934.  *    Signal settings get changed.
  935.  *
  936.  *----------------------------------------------------------------------
  937.  */
  938.  
  939. static void
  940. RestoreSignals()
  941. {
  942. #ifdef SIGABRT
  943.     signal(SIGABRT, SIG_DFL);
  944. #endif
  945. #ifdef SIGALRM
  946.     signal(SIGALRM, SIG_DFL);
  947. #endif
  948. #ifdef SIGFPE
  949.     signal(SIGFPE, SIG_DFL);
  950. #endif
  951. #ifdef SIGHUP
  952.     signal(SIGHUP, SIG_DFL);
  953. #endif
  954. #ifdef SIGILL
  955.     signal(SIGILL, SIG_DFL);
  956. #endif
  957. #ifdef SIGINT
  958.     signal(SIGINT, SIG_DFL);
  959. #endif
  960. #ifdef SIGPIPE
  961.     signal(SIGPIPE, SIG_DFL);
  962. #endif
  963. #ifdef SIGQUIT
  964.     signal(SIGQUIT, SIG_DFL);
  965. #endif
  966. #ifdef SIGSEGV
  967.     signal(SIGSEGV, SIG_DFL);
  968. #endif
  969. #ifdef SIGTERM
  970.     signal(SIGTERM, SIG_DFL);
  971. #endif
  972. #ifdef SIGUSR1
  973.     signal(SIGUSR1, SIG_DFL);
  974. #endif
  975. #ifdef SIGUSR2
  976.     signal(SIGUSR2, SIG_DFL);
  977. #endif
  978. #ifdef SIGCHLD
  979.     signal(SIGCHLD, SIG_DFL);
  980. #endif
  981. #ifdef SIGCONT
  982.     signal(SIGCONT, SIG_DFL);
  983. #endif
  984. #ifdef SIGTSTP
  985.     signal(SIGTSTP, SIG_DFL);
  986. #endif
  987. #ifdef SIGTTIN
  988.     signal(SIGTTIN, SIG_DFL);
  989. #endif
  990. #ifdef SIGTTOU
  991.     signal(SIGTTOU, SIG_DFL);
  992. #endif
  993. }
  994.  
  995. /*
  996.  *----------------------------------------------------------------------
  997.  *
  998.  * Tcl_PosixError --
  999.  *
  1000.  *    This procedure is typically called after UNIX kernel calls
  1001.  *    return errors.  It stores machine-readable information about
  1002.  *    the error in $errorCode returns an information string for
  1003.  *    the caller's use.
  1004.  *
  1005.  * Results:
  1006.  *    The return value is a human-readable string describing the
  1007.  *    error, as returned by strerror.
  1008.  *
  1009.  * Side effects:
  1010.  *    The global variable $errorCode is reset.
  1011.  *
  1012.  *----------------------------------------------------------------------
  1013.  */
  1014.  
  1015. char *
  1016. Tcl_PosixError(interp)
  1017.     Tcl_Interp *interp;        /* Interpreter whose $errorCode variable
  1018.                  * is to be changed. */
  1019. {
  1020.     char *id, *msg;
  1021.  
  1022.     id = Tcl_ErrnoId();
  1023.     msg = strerror(errno);
  1024.     Tcl_SetErrorCode(interp, "POSIX", id, msg, (char *) NULL);
  1025.     return msg;
  1026. }
  1027.  
  1028. /*
  1029.  *----------------------------------------------------------------------
  1030.  *
  1031.  * MakeFileTable --
  1032.  *
  1033.  *    Create or enlarge the file table for the interpreter, so that
  1034.  *    there is room for a given index.
  1035.  *
  1036.  * Results:
  1037.  *    None.
  1038.  *
  1039.  * Side effects:
  1040.  *    The file table for iPtr will be created if it doesn't exist
  1041.  *    (and entries will be added for stdin, stdout, and stderr).
  1042.  *    If it already exists, then it will be grown if necessary.
  1043.  *
  1044.  *----------------------------------------------------------------------
  1045.  */
  1046.  
  1047.     /* ARGSUSED */
  1048. static void
  1049. MakeFileTable(iPtr, index)
  1050.     Interp *iPtr;        /* Interpreter whose table of files is
  1051.                  * to be manipulated. */
  1052.     int index;            /* Make sure table is large enough to
  1053.                  * hold at least this index. */
  1054. {
  1055.     /*
  1056.      * If the table doesn't even exist, then create it and initialize
  1057.      * entries for standard files.
  1058.      */
  1059.  
  1060.     if (tclNumFiles == 0) {
  1061.     OpenFile *oFilePtr;
  1062.     int i;
  1063.  
  1064.     if (index < 2) {
  1065.         tclNumFiles = 3;
  1066.     } else {
  1067.         tclNumFiles = index+1;
  1068.     }
  1069.     tclOpenFiles = (OpenFile **) ckalloc((unsigned)
  1070.         ((tclNumFiles)*sizeof(OpenFile *)));
  1071.     for (i = tclNumFiles-1; i >= 0; i--) {
  1072.         tclOpenFiles[i] = NULL;
  1073.     }
  1074.  
  1075.     oFilePtr = (OpenFile *) ckalloc(sizeof(OpenFile));
  1076.     oFilePtr->f = stdin;
  1077.     oFilePtr->f2 = NULL;
  1078.     oFilePtr->permissions = TCL_FILE_READABLE;
  1079.     oFilePtr->numPids = 0;
  1080.     oFilePtr->pidPtr = NULL;
  1081.     oFilePtr->errorId = -1;
  1082.     tclOpenFiles[0] = oFilePtr;
  1083.  
  1084.     oFilePtr = (OpenFile *) ckalloc(sizeof(OpenFile));
  1085.     oFilePtr->f = stdout;
  1086.     oFilePtr->f2 = NULL;
  1087.     oFilePtr->permissions = TCL_FILE_WRITABLE;
  1088.     oFilePtr->numPids = 0;
  1089.     oFilePtr->pidPtr = NULL;
  1090.     oFilePtr->errorId = -1;
  1091.     tclOpenFiles[1] = oFilePtr;
  1092.  
  1093.     oFilePtr = (OpenFile *) ckalloc(sizeof(OpenFile));
  1094.     oFilePtr->f = stderr;
  1095.     oFilePtr->f2 = NULL;
  1096.     oFilePtr->permissions = TCL_FILE_WRITABLE;
  1097.     oFilePtr->numPids = 0;
  1098.     oFilePtr->pidPtr = NULL;
  1099.     oFilePtr->errorId = -1;
  1100.     tclOpenFiles[2] = oFilePtr;
  1101.     } else if (index >= tclNumFiles) {
  1102.     int newSize;
  1103.     OpenFile **newPtrArray;
  1104.     int i;
  1105.  
  1106.     newSize = index+1;
  1107.     newPtrArray = (OpenFile **) ckalloc((unsigned)
  1108.         ((newSize)*sizeof(OpenFile *)));
  1109.     memcpy((VOID *) newPtrArray, (VOID *) tclOpenFiles,
  1110.         tclNumFiles*sizeof(OpenFile *));
  1111.     for (i = tclNumFiles; i < newSize; i++) {
  1112.         newPtrArray[i] = NULL;
  1113.     }
  1114.     ckfree((char *) tclOpenFiles);
  1115.     tclNumFiles = newSize;
  1116.     tclOpenFiles = newPtrArray;
  1117.     }
  1118. }
  1119.  
  1120. /*
  1121.  *----------------------------------------------------------------------
  1122.  *
  1123.  * Tcl_EnterFile --
  1124.  *
  1125.  *    This procedure is used to enter an already-open file into the
  1126.  *    file table for an interpreter so that the file can be read
  1127.  *    and written with Tcl commands.
  1128.  *
  1129.  * Results:
  1130.  *    There is no return value, but interp->result is set to
  1131.  *    hold Tcl's id for the open file, such as "file4".
  1132.  *
  1133.  * Side effects:
  1134.  *    "File" is added to the files accessible from interp.
  1135.  *
  1136.  *----------------------------------------------------------------------
  1137.  */
  1138.  
  1139. void
  1140. Tcl_EnterFile(interp, file, permissions)
  1141.     Tcl_Interp *interp;        /* Interpreter in which to make file
  1142.                  * available. */
  1143.     FILE *file;            /* File to make available in interp. */
  1144.     int permissions;        /* Ops that may be done on file:  OR-ed
  1145.                  * combinination of TCL_FILE_READABLE and
  1146.                  * TCL_FILE_WRITABLE. */
  1147. {
  1148.     Interp *iPtr = (Interp *) interp;
  1149.     int fd;
  1150.     register OpenFile *oFilePtr;
  1151.  
  1152.     fd = fileno(file);
  1153.     if (fd >= tclNumFiles) {
  1154.     MakeFileTable(iPtr, fd);
  1155.     }
  1156.     oFilePtr = tclOpenFiles[fd];
  1157.  
  1158.     /*
  1159.      * It's possible that there already appears to be a file open in
  1160.      * the slot.  This could happen, for example, if the application
  1161.      * closes a file behind our back so that we don't have a chance
  1162.      * to clean up.  This is probably a bad idea, but if it happens
  1163.      * just discard the information in the old record (hopefully the
  1164.      * application is smart enough to have really cleaned everything
  1165.      * up right).
  1166.      */
  1167.  
  1168.     if (oFilePtr == NULL) {
  1169.     oFilePtr = (OpenFile *) ckalloc(sizeof(OpenFile));
  1170.     tclOpenFiles[fd] = oFilePtr;
  1171.     }
  1172.     oFilePtr->f = file;
  1173.     oFilePtr->f2 = NULL;
  1174.     oFilePtr->permissions = permissions;
  1175.     oFilePtr->numPids = 0;
  1176.     oFilePtr->pidPtr = NULL;
  1177.     oFilePtr->errorId = -1;
  1178.     if (fd <= 2) {
  1179.     if (fd == 0) {
  1180.         interp->result = "stdin";
  1181.     } else if (fd == 1) {
  1182.         interp->result = "stdout";
  1183.     } else {
  1184.         interp->result = "stderr";
  1185.     }
  1186.     } else {
  1187.     sprintf(interp->result, "file%d", fd);
  1188.     }
  1189. }
  1190.  
  1191. /*
  1192.  *----------------------------------------------------------------------
  1193.  *
  1194.  * Tcl_GetOpenFile --
  1195.  *
  1196.  *    Given a string identifier for an open file, find the corresponding
  1197.  *    open file structure, if there is one.
  1198.  *
  1199.  * Results:
  1200.  *    A standard Tcl return value.  If the open file is successfully
  1201.  *    located and meets any usage check requested by checkUsage, TCL_OK
  1202.  *    is returned and *filePtr is modified to hold a pointer to its
  1203.  *    FILE structure.  If an error occurs then TCL_ERROR is returned
  1204.  *    and interp->result contains an error message.
  1205.  *
  1206.  * Side effects:
  1207.  *    None.
  1208.  *
  1209.  *----------------------------------------------------------------------
  1210.  */
  1211.  
  1212. int
  1213. Tcl_GetOpenFile(interp, string, forWriting, checkUsage, filePtr)
  1214.     Tcl_Interp *interp;        /* Interpreter in which to find file. */
  1215.     char *string;        /* String that identifies file. */
  1216.     int forWriting;        /* 1 means the file is going to be used
  1217.                  * for writing, 0 means for reading. */
  1218.     int checkUsage;        /* 1 means verify that the file was opened
  1219.                  * in a mode that allows the access specified
  1220.                  * by "forWriting". */
  1221.     FILE **filePtr;        /* Store pointer to FILE structure here. */
  1222. {
  1223.     OpenFile *oFilePtr;
  1224.     int fd = 0;            /* Initial value needed only to stop compiler
  1225.                  * warnings. */
  1226.     Interp *iPtr = (Interp *) interp;
  1227.  
  1228.     if ((string[0] == 'f') && (string[1] == 'i') && (string[2] == 'l')
  1229.         & (string[3] == 'e')) {
  1230.     char *end;
  1231.  
  1232.     fd = strtoul(string+4, &end, 10);
  1233.     if ((end == string+4) || (*end != 0)) {
  1234.         goto badId;
  1235.     }
  1236.     } else if ((string[0] == 's') && (string[1] == 't')
  1237.         && (string[2] == 'd')) {
  1238.     if (strcmp(string+3, "in") == 0) {
  1239.         fd = 0;
  1240.     } else if (strcmp(string+3, "out") == 0) {
  1241.         fd = 1;
  1242.     } else if (strcmp(string+3, "err") == 0) {
  1243.         fd = 2;
  1244.     } else {
  1245.         goto badId;
  1246.     }
  1247.     } else {
  1248.     badId:
  1249.     Tcl_AppendResult(interp, "bad file identifier \"", string,
  1250.         "\"", (char *) NULL);
  1251.     return TCL_ERROR;
  1252.     }
  1253.  
  1254.     if (fd >= tclNumFiles) {
  1255.     if ((tclNumFiles == 0) && (fd <= 2)) {
  1256.         MakeFileTable(iPtr, fd);
  1257.     } else {
  1258.         notOpen:
  1259.         Tcl_AppendResult(interp, "file \"", string, "\" isn't open",
  1260.             (char *) NULL);
  1261.         return TCL_ERROR;
  1262.     }
  1263.     }
  1264.     oFilePtr = tclOpenFiles[fd];
  1265.     if (oFilePtr == NULL) {
  1266.     goto notOpen;
  1267.     }
  1268.     if (forWriting) {
  1269.     if (checkUsage && !(oFilePtr->permissions & TCL_FILE_WRITABLE)) {
  1270.         Tcl_AppendResult(interp, "\"", string,
  1271.             "\" wasn't opened for writing", (char *) NULL);
  1272.         return TCL_ERROR;
  1273.     }
  1274.     if (oFilePtr->f2 != NULL) {
  1275.         *filePtr = oFilePtr->f2;
  1276.     } else {
  1277.         *filePtr = oFilePtr->f;
  1278.     }
  1279.     } else {
  1280.     if (checkUsage && !(oFilePtr->permissions & TCL_FILE_READABLE)) {
  1281.         Tcl_AppendResult(interp, "\"", string,
  1282.             "\" wasn't opened for reading", (char *) NULL);
  1283.         return TCL_ERROR;
  1284.     }
  1285.     *filePtr = oFilePtr->f;
  1286.     }
  1287.     return TCL_OK;
  1288. }
  1289.  
  1290. /*
  1291.  *----------------------------------------------------------------------
  1292.  *
  1293.  * Tcl_FilePermissions --
  1294.  *
  1295.  *    Given a FILE * pointer, return the read/write permissions
  1296.  *    associated with the open file.
  1297.  *
  1298.  * Results:
  1299.  *    If file is currently open, the return value is an OR-ed
  1300.  *    combination of TCL_FILE_READABLE and TCL_FILE_WRITABLE,
  1301.  *    which indicates the operations permitted on the open file.
  1302.  *    If the file isn't open then the return value is -1.
  1303.  *
  1304.  * Side effects:
  1305.  *    None.
  1306.  *
  1307.  *----------------------------------------------------------------------
  1308.  */
  1309.  
  1310. int
  1311. Tcl_FilePermissions(file)
  1312.     FILE *file;            /* File for which permissions are wanted. */
  1313. {
  1314.     register OpenFile *oFilePtr;
  1315.     int i, fd;
  1316.  
  1317.     /*
  1318.      * First try the entry in tclOpenFiles given by the file descriptor
  1319.      * for the file.  If that doesn't match then search all the entries
  1320.      * in tclOpenFiles.
  1321.      */
  1322.  
  1323.     if (file != NULL) {
  1324.     fd = fileno(file);
  1325.     if (fd < tclNumFiles) {
  1326.         oFilePtr = tclOpenFiles[fd];
  1327.         if ((oFilePtr != NULL) && (oFilePtr->f == file)) {
  1328.         return oFilePtr->permissions;
  1329.         }
  1330.     }
  1331.     }
  1332.     for (i = 0; i < tclNumFiles; i++) {
  1333.     oFilePtr = tclOpenFiles[i];
  1334.     if (oFilePtr == NULL) {
  1335.         continue;
  1336.     }
  1337.     if ((oFilePtr->f == file) || (oFilePtr->f2 == file)) {
  1338.         return oFilePtr->permissions;
  1339.     }
  1340.     }
  1341.     return -1;
  1342. }
  1343.  
  1344. /*
  1345.  *----------------------------------------------------------------------
  1346.  *
  1347.  * TclOpen, etc. --
  1348.  *
  1349.  *    Below are a bunch of procedures that are used by Tcl instead
  1350.  *    of system calls.  Each of the procedures executes the
  1351.  *    corresponding system call and retries automatically
  1352.  *    if the system call was interrupted by a signal.
  1353.  *
  1354.  * Results:
  1355.  *    Whatever the system call would normally return.
  1356.  *
  1357.  * Side effects:
  1358.  *    Whatever the system call would normally do.
  1359.  *
  1360.  * NOTE:
  1361.  *    This should be the last page of this file, since it undefines
  1362.  *    the macros that redirect read etc. to the procedures below.
  1363.  *
  1364.  *----------------------------------------------------------------------
  1365.  */
  1366.  
  1367. #undef open
  1368. int
  1369. TclOpen(path, oflag, mode)
  1370.     char *path;
  1371.     int oflag;
  1372.     int mode;
  1373. {
  1374.     int result;
  1375.     while (1) {
  1376.     result = open(path, oflag, mode);
  1377.     if ((result != -1) || (errno != EINTR)) {
  1378.         return result;
  1379.     }
  1380.     }
  1381. }
  1382.  
  1383. #undef read
  1384. int
  1385. TclRead(fd, buf, numBytes)
  1386.     int fd;
  1387.     VOID *buf;
  1388.     size_t numBytes;
  1389. {
  1390.     int result;
  1391.     while (1) {
  1392.     result = read(fd, buf, (size_t) numBytes);
  1393.     if ((result != -1) || (errno != EINTR)) {
  1394.         return result;
  1395.     }
  1396.     }
  1397. }
  1398.  
  1399. #undef waitpid
  1400. extern pid_t waitpid _ANSI_ARGS_((pid_t pid, int *stat_loc, int options));
  1401.  
  1402. /*
  1403.  * Note:  the #ifdef below is needed to avoid compiler errors on systems
  1404.  * that have ANSI compilers and also define pid_t to be short.  The
  1405.  * problem is a complex one having to do with argument type promotion.
  1406.  */
  1407.  
  1408. #ifdef _USING_PROTOTYPES_
  1409. int
  1410. TclWaitpid _ANSI_ARGS_((pid_t pid, int *statPtr, int options))
  1411. #else
  1412. int
  1413. TclWaitpid(pid, statPtr, options)
  1414.     pid_t pid;
  1415.     int *statPtr;
  1416.     int options;
  1417. #endif /* _USING_PROTOTYPES_ */
  1418. {
  1419.     int result;
  1420.     while (1) {
  1421.     result = waitpid(pid, statPtr, options);
  1422.     if ((result != -1) || (errno != EINTR)) {
  1423.         return result;
  1424.     }
  1425.     }
  1426. }
  1427.  
  1428. #undef write
  1429. int
  1430. TclWrite(fd, buf, numBytes)
  1431.     int fd;
  1432.     VOID *buf;
  1433.     size_t numBytes;
  1434. {
  1435.     int result;
  1436.     while (1) {
  1437.     result = write(fd, buf, (size_t) numBytes);
  1438.     if ((result != -1) || (errno != EINTR)) {
  1439.         return result;
  1440.     }
  1441.     }
  1442. }
  1443.